' This program exported from BASIC Anywhere Machine (Version [5.2.3].[2023.09.17.17.11]) on 2023.10.07 at 17:33 (Coordinated Universal Time)
' A QB64 program by b+ as found at https://qb64.boards.net/post/1218
' BASIC Anywhere Machine port and mods by Charlie Veniot with the development version of BAM
Option _Explicit
_Title "Drw Strings try clock" 'b+ 2023-10-06
' Draw strings 2.bas SmallBASIC 0.12.9 (B+=MGA) 2017-05-06
'Deluxe draw strings.sdlbas [B+=MGA] 2017-01-03
'translated from:
'v2 turtle strings.bas SmallBASIC 0.12.2 [B+=MGA] 2016-04-04
'2017-05-08 fixes Box d and e for width and height
' test draw strings fixed for arc
'=================================================================
' Commands Set
'==================================================================
'Note all commands are a letter for function followed by number n
'commands pn -1 to 15, 0-15 are QB colors, -1 is pen up
'command xn set absolute screen coordinate for turtle x
'command yn set absolute screen coordinate for turtle y
'command gn move turtle relative to its current x position
' + n = right, -n = left (pneumonic g for go!)
'command hn move turtle relative to its current y position
' + n down?, -n up? depends which way the angle is set
' (pnuemonic h follows g like y follows x)
'command fn draws at current ta angle a distance of n
' (pnuemonic f is for forward use -n for back)
'command an sets angle or heading of turtle
' (pnuemonic a is for angle (degrees)
' 0 degrees is true North or 12 o'clock)
'command tn (turns) t=right n degrees when positive
' and turn left n degrees when negative
'v2 2016-04-05 the great and powerful repeat uses recursive sub
'command rn repeat drawstrings n amount of times
'command tv for setting a turtle var probably need another
'add 2 more commands for setting and incrementing the tv variable
'command sn will set tv at n value
'command in will increment tv with n value
'Deluxe draw strings 2017-01-03
' draw filled box current tx, ty is one corner
'command z for pen siZe radius to draw thick lines
'command dn sets box width
'command en sets box height
'command bn for Box color n = 0 - 15
'command un to set a circle radius
'command cn to draw a filled circle of color n = 0 - 15
'command jn to set the arc deg angle start
'command kn to set the arc deg angle end
'command ln draw arc color n = 0 - 15
'======================================================================
'turtle globals should you translate to another dialect
Dim Shared As Long tx, ty, tx2, ty2, tr, tc
Dim Shared scale, taStart, taStop, ta, tv, tz
scale = 1
Screen _NewImage(600, 600, 12) ' 16 color setting
COLOR 14
Dim h, m, s, ha, ma, sa
DECLARE Sub repete (tts$, times)
DECLARE Sub tt (tString$)
Do
Cls
'clock square frame, round face dots on perimeter
tt ("a0")
tt ("z1p-1x300y300d500e500b7d480e480b8u220c15y100t105")
tt ("r12f103t30u5c0u3c8")
m = Val(Mid$(Time$, 4, 2))
h = Val(Mid$(Time$, 1, 2)) + m / 60
s = Val(Mid$(Time$, 7, 2))
If h > 12 Then h = h - 12
'Print h, m, s
ha = h * 360 / 12
ma = m * 360 / 60
sa = s * 360 / 60
'Print ha, ma, sa
'hour hand
tt ("p-1a0x300y300t" + Str$(ha) + "p4z12f100")
'minute hand
tt ("p-1a0x300y300t" + Str$(ma) + "p0z7f180")
'second hand
tt ("p-1a0x300y300t" + Str$(sa) + "p7z3f180")
_Display
' _Limit 10
Loop ' Until _KeyDown(27)
'===================== turtle drawing subs
Sub tt (tString$)
Dim cmd$, ds$, c$, tst$
Dim As Long i, across, down, j
Dim d, dx, dy, stepper, lngth, aa
Dim As BYTE bNoAbort
tString$ = UCase$(tString$)
cmd$ = "": ds$ = ""
i = 1
bNoAbort = TRUE
WHILE i <= Len(tString$) AND bNoAbort
c$ = Mid$(tString$, i, 1)
If c$ = "V" Then ds$ = Str$(tv)
If InStr("0123456789.-", c$) Then ds$ = ds$ + c$
If InStr("ABCDEFGHIJKLPRSTUXYZ", c$) Or i = Len(tString$) Then
'execute last cmd$ if one
If cmd$ <> "" Then
d = Val(ds$)
Select Case cmd$
Case "G": tx = tx + d 'move relative to tx, ty
Case "H": ty = ty + d
Case "X": tx = d 'move to absolute screen x, y
Case "Y": ty = d
Case "D": tx2 = d '2nd corner box relative to tx
Case "E": ty2 = d '2nd corner box relative to ty
Case "J": taStart = d 'arc start angle
Case "K": taStop = d 'arc stop angle
Case "P": tc = d 'pen to qb color, -1 no pen
Case "Z": tz = d 'pen size
Case "A": ta = d 'set angle
Case "T": ta = ta + d 'change angle - = left, + = right
Case "U": tr = d 'set radius for circle (R used for repeat)
Case "I": tv = tv + d 'increment variable
Case "S": tv = d 'set or reset variable
Case "R" ' repeat calls out for another call to tt
tst$ = Mid$(tString$, i) ' this assumes the rest of the string
repete (tst$, d)
bNoAbort = FALSE
Case "F" 'Forward d distance according to angle ta
across = scale * d * Cos(_D2R(ta - 90))
down = scale * d * Sin(_D2R(ta - 90))
If tc > -1 Then
Color tc
If tz <= 1 Then
Line (tx, ty)-(tx + across, ty + down)
Else
lngth = ((across) ^ 2 + (down) ^ 2) ^ .5
If lngth Then
dx = across / lngth: dy = down / lngth
For j = 0 To lngth
CIRCLE (tx + dx * j, ty + dy * j), tz
Next
End If
End If
End If
tx = tx + across: ty = ty + down 'update turtle position
Case "B"
Color d
Line (tx - tx2 / 2, ty - ty2 / 2)-(tx + tx2 / 2, ty + ty2 / 2), , BF
Case "C"
Color d
CIRCLE (tx, ty), tr, , , , ,F
Case "L" 'arc ld u sets radius, j and k set start and end angle
If tc > -1 Then
Color d
stepper = 1 / (3 * _Pi * tr)
For aa = taStart To taStop Step stepper
dx = tr * Cos(_D2R(aa))
dy = tr * Sin(_D2R(aa))
If tz < 1 Then
PSet (tx + dx, ty + dy)
Else
CIRCLE (tx + dx, ty + dy), tz
End If
Next
End If
End Select
IF bNoAbort THEN ds$ = "": cmd$ = "" 'reset for next build of ds$ and cmd$
End If
IF bNoAbort THEN cmd$ = c$
End If
i = i + 1
WEND
End Sub
Sub repete (tts$, times)
Dim As Long i
For i = 1 To times
tt (tts$)
Next
End Sub